perm filename TABL.OLD[XX,LCS]1 blob sn#211908 filedate 1976-04-21 generic text, type T, neo UTF8
00100	C** TABL.F4 ** CONVERTS STANDARD NOTATION TO 1700 LUTE TABLATURE.
00200	
00300		SUBROUTINE EXTRA 
00400		IMPLICIT INTEGER(A-Q,S-Z)
00500		COMMON R2,JA,CENTR,J2,RJQ(20),JQ(20)/STF/RSC(8),RSTJ2
00550		1 /POSI/SF(8),JJ2,RPOS
00600		EQUIVALENCE (R4,RJQ(2)),(J5,JQ(3)),(R6,RJQ(4)),(R3,RJQ(1))
00700		1 ,(J6,JQ(4)),(R11,RJQ(9)),(J10,JQ(8)),(R5,RJQ(3)),(J3,JQ(1))
00800		1,(J11,JQ(9)),(RX3,RJQ(20)),(R9,RJQ(7)),(R8,RJQ(6)),(JR3,RJQ(19))
00850		1,(J7,JQ(5))
00900	
01000		DIMENSION RS(5),KEY(10),ISTR(6)
01100		DATA RS/2.,4.,6.,9.,11./,KEY/3,0,4,1,-1,5,2,6,3,0/
01200		1,ISTR/0,5,8,12,17,20/
01300	C RS CONVERTS STRING NUM TO LINE NUM.  KEY INCL'S. 4b TO 5#
01400	C ISTR HAS 12-TONE NOTE NUM OF STRINGS 1 TO 6(A=0)
01500	
01600		GO TO (1,2),JA
01700	15	J10=0
01705	1	IF(J10.NE.0)GO TO 50
01707	C STRNG NUM CAN BE SET IN J10 OR IN R6 -- 1=.001, 2=.002, ETC. J10 IS FIRST.
01708	C R6 IS USED IN 'TAB.F4' WHICH CONVERTS TABLATURE TO MS INPUT.
01710		R6=AMOD(R6*100.0,10.0)
01715	C  R6 WAS MULTIPLIED BY 10 IN NOTWRT.  .001 HAS BECOME .01, ETC.
01720		J10=R6
01760		R6=0
01780	50	IF(J10.NE.0)J10=7-J10
01800		IF(J11.EQ.0)GO TO 18
01900	C  J10 SETS STRING# (6→-6), J11 SETS LETTER OR NUM.(e.g.'-4' PRINTS '4',1=A)
01975	C  STRINGS ARE NUMBERED FROM HIGH TO LOW
02000		L=J10*2-1
02100	C  GETS STAFF POS FROM STRING NUM.
02200		N=J11
02300		IF(J10.GE.0.AND.N.GE.0)GO TO 9
02350		N=N+1
02400	16	L=-1
02500	C STRINGS 0 TO -6 ALL APPEAR BELOW 6-LINE STAFF.
02600		IF(N.GT.0)GO TO 9
02700	C JUMP IF FINGERED NOTE ON STRING 0
02705		IF(N.EQ.0)GO TO 13
02710		L=-3
02800		IF(N.LT.-3)GO TO 30
02900	C  NEXT FOR SLASHES OVER a.
03000		R4=0  
03100		R5=1.4
03200		JR3=R3
03300	C  SAVE FOR LATER
03400		R3=R3-7.*RSTJ2
03500		R6=RX3+4*RSTJ2
03600	C  RX3 IS ORIG. HORIZ. POS. (SCALE 0-200)
04000		JA=4
04010		J7=1
04050		RP=RPOS
04075	C SAVE VERT. POS. BASIS
04100		DO 32 K=1,-N
04200		J10=1
04250		R8=4.2
04260		R9=0
04300		CALL ITMSUB
04310		J3=JR3
04350		RPOS=RP
04400		R4=R4+.7
04500	32	R5=R5+.7
04700		N=0
04800		GO TO 13
04900	30	R6=51009999.-N*10000
05000		GO TO 31
05100	
05200	18	J=MOD(J5,10)
05300		M=R4
05310		IF(M.GT.-2)GO TO 21
05320		N=M+2
05330		GO TO 16
05400	21	N=MOD(M-1,7)+2
05500		IF(N.GT.6)N=N-7
05600	C  N IS NOTE NUMBER, WHERE A3=0
05700		IF(N)GO TO 16
05800	C  FOR ALL NOTES BELOW A3 GO BACK TO J11 ROUTINE.
05900		IF(J.EQ.0)GO TO 6
06000	C  JUMP IF NO  ACCI.
06100	
06200		IF(J.EQ.1)J=-1
06300		IF(J.EQ.2)J=1
06400		IF(J.EQ.3)J=0
06500	C  J= 1/2 STEP FROM CENTRAL PITCH
06600		GO TO 7
06700	6	IF(J6.EQ.0)GO TO 7
06800	C  GIVE KEYSIG. IN P6  +=#, -=b
06900		M=J6+5
07000		J=1
07100		IF(J6)J=-1
07200		DO 4 K=5,M,J
07300	4	IF(N.EQ.KEY(K))GO TO 7
07400	C LOOK FOR THE NOTE IN THE KEYSIG.
07500		J=0
07600	C  0= NOT FOUND IN KEYSIG.
07700	7	IF(J10.GT.0)GO TO 5
07800	C JUMP IF STRING IS SPECIFIED
07900		DO 10 L=1,5
08000	10	IF(R4.LT.RS(L))GO TO 20
08100		L=6
08200	C L IS STRING NUMBER.
08300	20	L=L*2-1
08400		IF(J.GE.0)GO TO 5
08500	C  NEXT CHECKS FOR FLATS THAT CHANGE STRING NUM.
08600		IF(N.EQ.0)GO TO 8
08700		IF(N.EQ.3)GO TO 8
08800		IF(N.NE.5)GO TO 5
08900	8	L=L-1
09000	C CHANGES Ab→G#, Db→C#
09100		N=N-1
09200		J=1
09300	C  DOESN'T ACCOUNT FOR F FLAT, ETC.
09400	
09500	5	NN=N*2
09600	C NEXT CONVERTS TO 12-TONE NUMS.
09700		IF(N.GT.1)NN=NN-1
09800		IF(N.GT.4)NN=NN-1
09900	C  COMPENSATES FOR B-C AND E-F 1/2 STEPS IN SCALE
10000		N=NN
10100		IF(J10.GT.0)GO TO 14
10200		IF(R4.GE.13)GO TO 17
10300		IF(NN.GT.4)N=NN-5
10400		IF(NN.GT.7)N=NN-8
10500	C N IS NOW A LETTER ON A OR D OR F STRING (0=A, 1=B, ETC.)
10600	
10700	11	N=N+J
10800		GO TO 9
10900	17	J10=6
11000	14	IF(J10.GT.6)GO TO 15
11100		R5=R4
11200		IF(J)R5=R5-1.
11300		IF(R5.GE.6.)N=N+12
11400		IF(R5.GE.13.)N=N+12
11500		N=N-ISTR(J10)+J
11600		IF(N)GO TO 15
11700		L=J10*2-1
11800	
11900	9	IF(N.EQ.2)N=17
12000	C  CHANGES C TO R
12100	13	R6=51709999.0+N*10000   
12200	31	R5=.95
12300		R4=L+1.5
12400		IF(N.EQ.3)R11=270
12500	C ROTATES 'D'
12550		J3=J3+6.*RSTJ2
12600		CALL ALPHA
12700	2	END